home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / compmrk.com / COMPMARK.ASM < prev    next >
Encoding:
Assembly Source File  |  1989-12-27  |  14.2 KB  |  478 lines

  1. IDEAL
  2. ; COMPMARK.ASM - Implements Markov model splay tree compression on top of run
  3. ; length encoding.  See COMPMARK.PAS unit for details.
  4. ;
  5. ; This routine contributed to the public domain by the author:
  6. ;
  7. ;   Edwin T. Floyd [76067,747]
  8. ;   #9 Adams Park Ct.
  9. ;   Columbus, GA 31909
  10. ;   404-576-3305 (work)
  11. ;   404-322-0076 (home)
  12. ;
  13. ; Please report errors to me and if you create a better performing
  14. ; implementation, please post it or send me a copy.
  15. ;
  16. ; This program was inspired by the Pascal implementation: SPLAY.PAS by
  17. ; Kim Kokkenen.
  18. ;
  19. ; Borland's Turbo Assembler - TASM is required to assemble this program.
  20. ;
  21.  
  22. STRUC    workarea ; parameter from caller
  23. bitstate dw     (?)                ; last compressed byte and bit position
  24. treeds   dw     (?)                ; reg ds for current state tree
  25. statmask db     (?)                ; bit mask to compute next state
  26. filler   db     11 dup (?)         ; fill to end of paragraph
  27. ENDS
  28.  
  29. STRUC    splaytree ; trees, 1.5K each, follow workarea
  30. left     dw     256 dup (?)        ; left pointers
  31. right    dw     256 dup (?)        ; right pointers
  32. up       db     512 dup (?)        ; up pointers and characters
  33. ENDS
  34.  
  35. splsize  equ    96                 ; size in paragraphs of each splaytree
  36. work     equ    (workarea PTR si)  ; equates for addressability
  37. tree     equ    (splaytree PTR si)
  38.  
  39. SEGMENT  code BYTE PUBLIC
  40.          ASSUME cs:code
  41.  
  42. PROC     Splay NEAR
  43. ; Rearrange the splay tree for each succeeding character (passed in al).
  44. ; Stomps registers AX,BX,CX,DX
  45.          ASSUME ds:workarea
  46.          push   ds
  47.          push   di
  48.          mov    cl,al              ; Save character
  49.          and    al,[work.statmask] ; Compute tree seg for next state
  50.          mov    ah,splsize
  51.          mul    ah
  52.          mov    bx,ds
  53.          inc    bx
  54.          add    ax,bx
  55.          xchg   ax,[work.treeds]
  56.          mov    ds,ax              ; point to tree for current state
  57.          ASSUME ds:splaytree
  58.          mov    al,cl              ; Restore character
  59.          xor    ah,ah
  60.          add    ax,255             ; A := Plain + MaxChar
  61. @@nextrep:                         ; Repeat
  62. ;
  63. ; Walk up the tree semi-rotating pairs
  64. ;
  65.          mov    bx,ax              ;   C := Up[A];
  66.          mov    cl,[bx+tree.up]
  67.          or     cl,cl              ;   If C <> Root Then Begin
  68.          jz     @@done
  69.          xor    ch,ch              ;   D := Up[C];
  70.          mov    bx,cx
  71.          mov    dl,[bx+tree.up]
  72.          xor    dh,dh
  73. ;
  74. ; Exchange children of pair
  75. ;
  76.          mov    bx,dx              ;   B := Left[D];
  77.          shl    bx,1
  78.          mov    di,[bx+tree.left]
  79.          mov    bx,dx
  80.          shl    bx,1
  81.          cmp    cx,di              ;   If C = B Then Begin
  82.          jnz    @@jmp1
  83.          mov    di,[bx+tree.right] ;     B := Right[D];
  84.          mov    [bx+tree.right],ax ;     Right[D] := A;
  85.          jmp    SHORT @@skip1      ;   End Else
  86. @@jmp1:
  87.          mov    [bx+tree.left],ax  ;     Left[D] := A;
  88. @@skip1:
  89.          mov    bx,cx              ;   If A = Left[C] Then
  90.          shl    bx,1
  91.          cmp    [bx+tree.left],ax
  92.          jnz    @@jmp2
  93.          mov    [bx+tree.left],di  ;     Left[C] := B
  94.          jmp    SHORT @@skip2      ;   Else
  95. @@jmp2:
  96.          mov    [bx+tree.right],di ;     Right[C] := B;
  97. @@skip2:
  98.          mov    bx,ax              ;   Up[A] := D;
  99.          mov    [bx+tree.up],dl
  100.          mov    bx,di              ;   Up[B] := C;
  101.          mov    [bx+tree.up],cl
  102.          mov    ax,dx              ;   A := D;
  103.          or     ax,ax              ; Until A = Root;
  104.          jnz    @@nextrep
  105. @@done:
  106.          pop    di
  107.          pop    ds
  108.          ret
  109. ENDP
  110.  
  111. PROC     Compress NEAR
  112. ; Compress a byte (passed in al; output goes to [ES:DI])
  113. ; Stomps register AX
  114.          ASSUME ds:workarea
  115.          push   bx
  116.          push   cx
  117.          push   dx
  118.          push   ax
  119.          push   bp
  120.          mov    bp,ds
  121.          mov    ds,[work.treeds]
  122.          ASSUME ds:splaytree
  123.          xor    ah,ah              ; A := Plain + MaxChar
  124.          add    ax,255
  125.          xor    cx,cx              ; zero bit stack
  126.          xor    dx,dx
  127. ;
  128. ; Walk up the tree pushing bits onto stack
  129. ;
  130. @@nextrep:                         ; Repeat
  131.          mov    bx,ax              ;   U := Up[A];
  132.          mov    bl,[bx+tree.up]
  133.          xor    bh,bh
  134.          shl    bx,1               ;   If Right[U] = A Then
  135.          cmp    [bx+tree.right],ax
  136.          jnz    @@skip1
  137.          or     dl,1               ;     Set 1 bit
  138. @@skip1:                           ;   Else Set 0 bit;
  139.          shr    bx,1
  140.          inc    cx                 ;   Stack bit just set;
  141.          test   cl,0Fh
  142.          jnz    @@skip2
  143.          push   dx
  144.          xor    dx,dx
  145. @@skip2:
  146.          shl    dx,1
  147.          mov    ax,bx              ;    A := U;
  148.          or     ax,ax              ;  Until A = Root;
  149.          jnz    @@nextrep
  150. ;
  151. ; Cx now contains the number of bits pushed.  Pop cx bits off the stack.
  152. ;
  153.          mov    ds,bp
  154.          ASSUME ds:workarea
  155.          shr    dx,1               ; Pop off un-set bit position
  156.          mov    ax,[work.bitstate] ; Restore output position
  157. @@nextbit:                         ; Repeat
  158.          test   cl,0Fh             ;   Pop off a bit
  159.          jnz    @@skip3
  160.          pop    dx
  161. @@skip3:
  162.          shr    dx,1
  163.          rcr    al,1
  164.          shl    ah,1
  165.          jnc    @@skip4            ;   If al is full
  166.          stosb                     ;   push it out
  167.          inc    ah
  168. @@skip4:
  169.          loop   @@nextbit          ; Until all bits are popped
  170.          mov    [work.bitstate],ax ; Save output position
  171.          pop    bp
  172.          pop    ax                 ; Restore original character
  173.          call   Splay              ; Twist the tree
  174.          pop    dx
  175.          pop    cx
  176.          pop    bx
  177.          ret
  178. ENDP
  179.  
  180. PROC     Expand NEAR
  181. ; Expand a byte (returned in al, input comes from [ES:DI])
  182. ; Stomps register AX
  183.          ASSUME ds:workarea
  184.          push   bx
  185.          push   cx
  186.          push   dx
  187.          push   ds
  188.          mov    ax,[work.bitstate] ; Restore input position
  189.          mov    ds,[work.treeds]
  190.          ASSUME ds:splaytree
  191.          xor    bx,bx              ; A := Root;
  192. ;
  193. ; Scan the tree to a leaf, which determines the character
  194. ;
  195. @@nextbit:                         ; Repeat
  196.          shl    bx,1               ;
  197.          shl    ah,1               ;   If this input character is used up Then
  198.          jnc    @@skip1
  199.          mov    al,[BYTE es:di]    ;     get the next input character
  200.          inc    di                 ;
  201.          inc    ah                 ;     and reset the bit position
  202. @@skip1:
  203.          shr    al,1               ;   Case nextbit Of
  204.          jc     @@skip2
  205.          mov    bx,[bx+tree.left]  ;     0 : A := Left[A];
  206.          jmp    SHORT @@skip3
  207. @@skip2:
  208.          mov    bx,[bx+tree.right] ;     1 : A := Right[A];
  209. @@skip3:                           ;   End;
  210.          cmp    bx,255             ; Until A >= MaxChar;
  211.          jb     @@nextbit
  212.  
  213.          pop    ds
  214.          ASSUME ds:workarea
  215.          mov    [work.bitstate],ax ; Save input position
  216.          mov    ax,bx
  217.          sub    ax,255             ; A := A - MaxChar;
  218.          push   ax                 ; Save character just found
  219.          call   Splay              ; Twist the tree
  220.          pop    ax                 ; Restore and exit
  221.          pop    dx
  222.          pop    cx
  223.          pop    bx
  224.          ret
  225. ENDP
  226.  
  227.          MODEL TPASCAL
  228. PUBLIC   InitSplay
  229. PROC     InitSplay NEAR workptr:DWORD,bits:WORD
  230. ; Initialize the splay tree[s] - as balanced.
  231. ; Stomps registers AX,BX,CX
  232.          push   ds
  233.          lds    si,[workptr]
  234.          ASSUME ds:workarea
  235.          mov    cx,[bits]          ; create state mask and tree count
  236.          xor    ch,ch
  237.          cmp    cl,8
  238.          jbe    @@bitsok
  239.          mov    cl,8
  240. @@bitsok:
  241.          mov    ax,1               ; ax = tree count
  242.          xor    bl,bl              ; bl = state mask
  243.          jcxz   @@skipmask
  244. @@loop1:
  245.          or     bl,al
  246.          shl    ax,1
  247.          loop   @@loop1
  248. @@skipmask:
  249.          mov    cx,ax
  250.          mov    [work.statmask],bl
  251.          mov    ax,ds              ; point to first tree
  252.          inc    ax
  253.          mov    [work.treeds],ax
  254.          mov    ds,ax
  255.          ASSUME ds:splaytree
  256. @@nexttree:                        ; initialize all trees
  257.          push   cx
  258.          mov    cx,512
  259.          xor    bx,bx
  260. @@nextup:
  261.          mov    ax,bx
  262.          dec    ax
  263.          shr    ax,1
  264.          mov    [bx+tree.up],al
  265.          inc    bx
  266.          loop   @@nextup
  267.  
  268.          mov    cx,256
  269.          xor    ax,ax
  270.          mov    bx,ax
  271. @@nextlr:
  272.          inc    ax
  273.          mov    [bx+tree.left],ax
  274.          inc    ax
  275.          mov    [bx+tree.right],ax
  276.          mov    bx,ax
  277.          loop   @@nextlr
  278.          pop    cx
  279.          mov    ax,ds
  280.          add    ax,splsize
  281.          mov    ds,ax
  282.          loop   @@nexttree
  283.          pop    ds
  284.          ret
  285. ENDP
  286.  
  287. PUBLIC   CompressBuffer
  288. PROC     CompressBuffer NEAR workptr:DWORD,inbuf:DWORD,inlen:WORD,outbuf:DWORD
  289. ; Compress buffer pointed to by [inbuf] for [inlen] characters placing the
  290. ; output in the area pointed to by [outbuf].  [workptr] points to a 1.5K work
  291. ; area.  Stomps AX,BX,CX,DX,ES,DI,SI.
  292. ; Pascal declaration:
  293. ;   Function CompressBuffer(Var work; Var inbuf; inlen : Word
  294. ;     Var outbuf) : Word; External;
  295. ;
  296.          push   ds
  297.          cld
  298.          lds    si,[workptr]
  299.          ASSUME ds:workarea
  300.          mov    cx,[inlen]
  301.          les    di,[outbuf]
  302.          push   di
  303.          xor    ax,ax
  304.          inc    ah
  305.          mov    [work.bitstate],ax
  306.          xor    bx,bx
  307.          mov    dl,' '
  308.          xor    dh,dh
  309. @@nextchar:
  310. ; Loop compressing characters.  Input characters are run-length-encoded first.
  311. ; Input is segmented into "duplicate" character segments and "non-duplicate"
  312. ; segments of not more than 127 bytes each.  Each segment is prefixed by a
  313. ; one-byte tag.  The high-order bit in the tag indicates the segment type:
  314. ; 1=>non-duplicate, 0=>duplicate.  The remaining bits indicate the length
  315. ; of the data.  Non-duplicate segment tags are followed by the segment data;
  316. ; duplicate segments indicate a repetition of the last character compressed.
  317. ; Register dl contains the last plain-text character examined, and the segment
  318. ; tag is constructed in dh.
  319. ;
  320.          lds    si,[inbuf]
  321.          test   dh,080h
  322.          jz     @@testdup
  323. ;
  324. ; we're in a segment of mostly non-duplicate characters
  325. ;
  326.          mov    al,[BYTE bx+si]
  327.          inc    bx
  328.          dec    dh
  329.          test   dh,07Fh
  330.          jnz    @@pressit
  331.          xor    dh,dh
  332.          jmp    SHORT @@pressit
  333. @@testdup:
  334. ; test for at least three duplicate characters in a row
  335. ;
  336.          cmp    [BYTE bx+si],dl
  337.          jnz    @@nondup
  338.          cmp    [BYTE bx+si+1],dl
  339.          jnz    @@nondup
  340.          xor    dh,dh
  341. @@duploop:
  342. ; count duplicate characters
  343. ;
  344.          inc    dh
  345.          inc    bx
  346.          cmp    dh,07Fh
  347.          jnb    @@dupend
  348.          cmp    [BYTE bx+si],dl
  349.          jne    @@dupend
  350.          loop   @@duploop
  351.          inc    cx
  352. ; we've either run out of duplicates or we have 127 of them; compress the tag
  353. ;
  354. @@dupend:
  355.          mov    al,dh
  356.          jmp    SHORT @@pressit
  357. @@nondup:
  358. ; we have a segment of mostly non-duplicate characters
  359. ;
  360.          push   bx
  361.          push   cx
  362.          xor    dh,dh
  363. @@nonloop:
  364. ; count the non-duplicates
  365. ;
  366.          mov    dl,[BYTE bx+si]
  367.          inc    bx
  368.          inc    dh
  369.          cmp    dh,07Fh
  370.          jnb    @@nonend
  371.          cmp    [BYTE bx+si],dl
  372.          jnz    @@nonnext
  373.          cmp    [BYTE bx+si+1],dl
  374.          jz     @@nonend
  375. @@nonnext:
  376.          loop   @@nonloop
  377. @@nonend:
  378. ; we've either hit a duplicate segment, run out of input, or hit the 127
  379. ; character limit.  build the tag byte and compress it.
  380. ;
  381.          pop    cx
  382.          pop    bx
  383.          inc    cx
  384.          or     dh,080h
  385.          mov    al,dh
  386. @@pressit:
  387. ; compress rle character with Splay tree
  388. ;
  389.          lds    si,[workptr]
  390.          call   Compress
  391.          loop   @@nextchar
  392. ;
  393. ; Compression done, flush the last byte if necessary
  394. ;
  395.          mov    ax,[work.bitstate]
  396.          cmp    ah,1
  397.          jz     @@skip1
  398. @@loop1:
  399. ; right justify last byte
  400. ;
  401.          shr    al,1
  402.          shl    ah,1
  403.          jnc    @@loop1
  404.          stosb
  405. @@skip1:
  406.          mov    ax,di
  407.          pop    bx
  408.          sub    ax,bx     ; Length of compressed data is function result in AX
  409.          pop    ds
  410.          ret
  411. ENDP
  412.  
  413. PUBLIC   ExpandBuffer
  414. PROC     ExpandBuffer NEAR workptr:DWORD,inbuf:DWORD,outbuf:DWORD,outlen:WORD
  415. ; Expand buffer pointed to by [inbuf] placing the output in the area pointed
  416. ; to by [outbuf] for [outlen] characters.  [workptr] points to a 1.5K work
  417. ; area.  Stomps AX,BX,CX,DX,ES,DI,SI.
  418. ; Pascal declaration:
  419. ;   Procedure ExpandBuffer(Var work; Var inbuf; Var outbuf; outlen : Word)
  420. ;   External;
  421. ;
  422.          push   ds
  423.          cld
  424.          lds    si,[workptr]
  425.          ASSUME ds:workarea
  426.          mov    cx,[outlen]
  427.          les    di,[inbuf]
  428.          xor    al,al
  429.          mov    ah,080h
  430.          mov    [work.bitstate],ax
  431.          xor    bx,bx
  432.          xor    dh,dh
  433.          mov    dl,' ';
  434. ;
  435. ; Loop expanding characters
  436. ;
  437. @@nextchar:
  438.          test   dh,080h
  439.          jz     @@testdup
  440. ;
  441. ; We're in the midst of a non-duplicate segment
  442. ;
  443.          call   expand
  444.          mov    dl,al
  445.          dec    dh
  446.          test   dh,07Fh
  447.          jnz    @@putit
  448.          xor    dh,dh
  449.          jmp    SHORT @@putit
  450. @@testdup:
  451.          or     dh,dh          ; Are we in a duplicate segment?
  452.          jz     @@nextgroup
  453.          mov    al,dl          ; yes, we already have the character
  454.          dec    dh
  455.          jmp    SHORT @@putit
  456. @@nextgroup:
  457. ; The next character is a segment tag; get it
  458. ;
  459.          call   expand
  460.          mov    dh,al
  461.          jmp    @@nextchar
  462. @@putit:
  463. ; We have a character; put it in the output buffer
  464. ;
  465.          lds    si,[outbuf]
  466.          mov    [bx+si],al
  467.          inc    bx
  468.          lds    si,[workptr]
  469.          loop   @@nextchar
  470. ;
  471. ; Expansion done - restore ds and exit
  472. ;
  473.          pop    ds
  474.          ret
  475. ENDP
  476. ENDS
  477. END
  478.